home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / fish / 001-100 / 001-025 / 024 / modula-2 / m2 / reqdemo.mod < prev    next >
Text File  |  1995-03-17  |  6KB  |  210 lines
  1. (********************************************************************************
  2.  
  3. Name         : ReqDemo.MOD
  4. Version      : 1.0
  5. Purpose      : Demo for use of Requesters   ( AutoRequest )
  6. Author       : ms
  7. Modified     : 2.4.86  11:00  ms
  8.  
  9. ********************************************************************************)
  10.  
  11. MODULE ReqDemo;
  12.  
  13. FROM SYSTEM    IMPORT ADDRESS, BYTE, ADR, TSIZE;
  14. FROM Terminal  IMPORT WriteString, WriteLn;
  15. FROM System    IMPORT Allocate, Deallocate;
  16. FROM AMIGADos  IMPORT Delay;
  17. FROM AMIGABase IMPORT Regs, LibCall, ExecBase, ExecOpenLib;
  18.  
  19. CONST JAM2          =      1;
  20.       ACTIVATE      =  4096D;
  21.       WINDOWDRAG    =     2D;
  22.       WINDOWDEPTH   =     4D;
  23.       WINDOWSIZING  =     1D;
  24.       NOCAREREFRESH =131072D;
  25.       WBSCREEN      =    01H; 
  26.  
  27. TYPE StringPtr = POINTER TO ARRAY [0..29999] OF CHAR;
  28.      NewWindow = RECORD
  29.                    leftEdge,
  30.                    topEdge,
  31.                    width,
  32.                    height: CARDINAL;
  33.                    detailPen,
  34.                    blockPen: BYTE;
  35.                    IDCMPFlags,
  36.                    flags: LONGINT;
  37.                    firstGadget,
  38.                    checkMark: LONGINT;
  39.                    title: StringPtr;
  40.                    screen,
  41.                    bitMap: ADDRESS;
  42.                    minWidth,
  43.                    minHeight,
  44.                    maxWidth,
  45.                    maxHeight: CARDINAL;
  46.                    type: CARDINAL
  47.                  END;
  48.   IntuiTextPtr = POINTER TO IntuiText;
  49.      IntuiText = RECORD
  50.                    frontPen, backPen, drawMode: BYTE;
  51.                    leftEdge, topEdge: INTEGER;
  52.                    iTextFont, iText: ADDRESS;
  53.                    nextText: IntuiTextPtr;
  54.                  END;
  55. (*   dummy types for window data structure *)
  56.      Window    = ARRAY [0..63] OF CARDINAL;
  57.      WindowPtr = POINTER TO Window;
  58.  
  59. VAR nw: NewWindow;
  60.     w: WindowPtr;
  61.     intuibase: LONGINT;
  62.     bodyTextPtr, pTextPtr, nTextPtr, dummy: IntuiTextPtr;
  63.  
  64. PROCEDURE AllocString(VAR p: ADDRESS; st: ARRAY OF CHAR);
  65. VAR i, j: CARDINAL;
  66.     s: StringPtr;
  67. BEGIN i:=0;
  68.   WHILE (i<=HIGH(st)) & (st[i]#0C) DO INC(i) END;
  69.   Allocate(p, i);
  70.   IF p#NIL THEN
  71.     s:=StringPtr(p);
  72.     FOR j:=0 TO i-1 DO s^[j]:=st[j] END;
  73.     s^[i]:=0C;
  74.   END
  75. END AllocString;
  76.    
  77. PROCEDURE OpenLibrary(st: ARRAY OF CHAR): LONGINT;
  78. VAR r: Regs; p: ADDRESS;
  79. BEGIN
  80.   AllocString(p, st);
  81.   r.a[1]:=p;
  82.   r.d[0]:=0D;
  83.   LibCall(ExecBase(), ExecOpenLib(), r);
  84.   Deallocate(p);
  85.   RETURN r.d[0]  
  86. END OpenLibrary;
  87.  
  88. PROCEDURE OpenWindow(VAR nw: NewWindow): WindowPtr;
  89. VAR r: Regs;
  90. BEGIN
  91.   r.a[0]:=ADR(nw);
  92.   LibCall(intuibase, -204D, r);
  93.   RETURN WindowPtr(r.d[0]);
  94. END OpenWindow;
  95.  
  96. PROCEDURE CloseWindow(w: WindowPtr);
  97. VAR r: Regs;
  98. BEGIN
  99.   r.a[0]:=LONGINT(w);
  100.   LibCall(intuibase, -72D, r);
  101. END CloseWindow;
  102.  
  103. PROCEDURE AutoRequest(win: WindowPtr; bodyText, pText, nText: IntuiTextPtr;
  104.                       pFlag, nFlag, w, h: LONGINT): BOOLEAN;
  105. VAR r: Regs;
  106. BEGIN
  107.   r.a[0]:=LONGINT(win);
  108.   r.a[1]:=LONGINT(bodyText);
  109.   r.a[2]:=LONGINT(pText);
  110.   r.a[3]:=LONGINT(nText);
  111.   r.d[0]:=pFlag;
  112.   r.d[1]:=nFlag;
  113.   r.d[2]:=w;
  114.   r.d[3]:=h;
  115.   LibCall(intuibase, -348, r);
  116.   RETURN r.d[0]#0D
  117. END AutoRequest;
  118.  
  119. PROCEDURE NewIText(text: ARRAY OF CHAR; left, top: INTEGER): IntuiTextPtr;
  120. VAR newText: IntuiTextPtr;
  121. BEGIN
  122.   Allocate(newText, TSIZE(IntuiText));
  123.   WITH newText^ DO
  124.     AllocString(iText, text);
  125.     frontPen:=BYTE(0); backPen:=BYTE(1);
  126.     drawMode:=BYTE(JAM2);
  127.     leftEdge:=left; topEdge:=top;
  128.     iTextFont:=NIL;
  129.     nextText:=NIL
  130.   END;
  131.   RETURN newText
  132. END NewIText;
  133.  
  134. PROCEDURE AddIText(VAR intuiText: IntuiTextPtr;
  135.                    text: ARRAY OF CHAR): IntuiTextPtr;
  136. VAR newtext: IntuiTextPtr;
  137. BEGIN
  138.   Allocate(newtext, TSIZE(IntuiText));
  139.   WITH newtext^ DO
  140.     AllocString(iText, text);
  141.     frontPen:=intuiText^.frontPen;
  142.     backPen:=intuiText^.backPen;
  143.     drawMode:=intuiText^.drawMode;
  144.     leftEdge:=intuiText^.leftEdge;
  145.     topEdge:=intuiText^.topEdge+11;
  146.     iTextFont:=intuiText^.iTextFont;
  147.     nextText:=NIL;
  148.   END;
  149.   intuiText^.nextText:=newtext;
  150.   RETURN newtext
  151. END AddIText;
  152.  
  153. PROCEDURE DisposeIText(VAR intuiText: IntuiTextPtr);
  154. VAR save: IntuiTextPtr;
  155. BEGIN
  156.   WHILE intuiText#NIL DO    
  157.     save:=intuiText^.nextText;
  158.     Deallocate(intuiText);
  159.     intuiText:=save
  160.   END
  161. END DisposeIText;
  162.  
  163. BEGIN
  164.   WriteString('Requster Demo'); WriteLn;
  165.   WriteString('============='); WriteLn; WriteLn;
  166.   intuibase:=OpenLibrary('intuition.library');
  167.   IF intuibase=0D THEN
  168.     WriteString('Error: library not opened'); WriteLn
  169.   ELSE
  170.     WITH nw DO
  171.       leftEdge:=300;
  172.       topEdge:=100;
  173.       width:=200;
  174.       height:=50;
  175.       detailPen:=BYTE(0);
  176.       blockPen:=BYTE(1);
  177.       IDCMPFlags:=0;
  178.       flags:=WINDOWDRAG + WINDOWDEPTH + WINDOWSIZING + NOCAREREFRESH;
  179.       firstGadget:=NIL;
  180.       checkMark:=NIL;
  181.       AllocString(title, "Requester Demo ");
  182.       screen:=NIL;
  183.       bitMap:=NIL;
  184.       minWidth:=150;
  185.       minHeight:=25;
  186.       maxWidth:=200;
  187.       maxHeight:=50;
  188.       type:=WBSCREEN 
  189.     END;
  190.     w:=OpenWindow(nw);
  191.     IF w#NIL THEN
  192.       bodyTextPtr:=NewIText("Requester brought up by ", 12, 5);
  193.       dummy:=AddIText(bodyTextPtr, "a Modula 2 Program.");
  194.       dummy:=AddIText(dummy, "True or False ???");
  195.       nTextPtr:=NewIText("FALSE", 6, 3);
  196.       pTextPtr:=NewIText("TRUE", 6, 3);
  197.       REPEAT
  198.         Delay(50);
  199.       UNTIL AutoRequest(w, bodyTextPtr, pTextPtr, nTextPtr, 0, 0, 296, 76);
  200.       DisposeIText(bodyTextPtr);
  201.       DisposeIText(pTextPtr);
  202.       DisposeIText(nTextPtr);
  203.       CloseWindow(w)
  204.     ELSE
  205.       WriteString('Error: Window not opend'); WriteLn
  206.     END;
  207.   END;
  208.   WriteString("You got it! Yes it's true"); WriteLn; WriteLn
  209. END ReqDemo.
  210.